home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tool-inc.zip / TREELIB.INC < prev    next >
Text File  |  1989-06-02  |  6KB  |  246 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * treelib.inc - Utility library to build, sort and output trees
  15.  *               in a real visual "tree" format. (3-1-89)
  16.  *
  17.  *)
  18.  
  19. const
  20.    maxsubs = 150;                  {maximum number of subnodes for
  21.                                     any single node in the tree}
  22.  
  23.    ascii_tree: boolean = false;    {set to true for ASCII only tree
  24.                                     output; full IBM character set is
  25.                                     used by default}
  26.  
  27.  
  28. type
  29.    long_string = string[255];       {maximum length of an output line}
  30.  
  31.    subnode_index = 0..maxsubs;
  32.  
  33.    name_string = string[40];        {maximum length of the name of a single
  34.                                     tree node}
  35.  
  36.    subnode_table = ^subnode_tabletype;
  37.    node_ptr = ^node_rec;
  38.    subnode_tabletype = array[1..maxsubs] of node_ptr;
  39.  
  40.    node_rec = record
  41.       name:   name_string;          {the name of the node}
  42.  
  43.       count:  subnode_index;        {the count of subnodes}
  44.  
  45.       subs:   subnode_table;        {pointer to subnode table, if any}
  46.    end;
  47.  
  48.  
  49. type
  50.    connector_codes =
  51.      (horizontal, tee, top, cross, middle, bottom, vertical, spaces, empty);
  52.  
  53. const
  54.    connector_strings: array [boolean, connector_codes] of string[3] =
  55.      (('───', '─┬─', ' ┌─', '─┼─', ' ├─', ' └─', ' │ ', '   ', ''),
  56.  
  57.       ('---', '-+-', ' +-', '-|-', ' |-', ' +-', ' | ', '   ', ''));
  58.  
  59.  
  60.  
  61. (*
  62.  * new_node - create and return a new empty node
  63.  *
  64.  * note:  the subnode table node^.subs must be allocated
  65.  *        by the user before any subnodes can be
  66.  *        created.  this was done to eliminate the
  67.  *        space needed by the subnode table on the
  68.  *        terminal nodes in the tree.
  69.  *
  70.  *)
  71.  
  72. function new_node: node_ptr;
  73. var
  74.    node: node_ptr;
  75.    i:    subnode_index;
  76.  
  77. begin
  78.    new (node);
  79.    node^.name := '';
  80.    node^.count := 0;
  81.    node^.subs := nil;
  82.    new_node := node;
  83. end;
  84.  
  85.  
  86.  
  87. (*
  88.  * dispose_tree - dispose of a tree
  89.  *
  90.  *)
  91.  
  92. procedure dispose_tree(var node:  node_ptr);
  93. var
  94.    i:      subnode_index;
  95.  
  96. begin
  97.    if node <> nil then
  98.    begin
  99.       with node^ do
  100.          for i := 1 to count do
  101.             dispose_tree(subs^[i]);
  102.  
  103.       if node^.subs <> nil then
  104.          dispose(node^.subs);
  105.  
  106.       dispose(node);
  107.       node := nil;
  108.    end;
  109. end;
  110.  
  111.  
  112.  
  113. (*
  114.  * sort_node - sort the entries in a node
  115.  *
  116.  *)
  117.  
  118. procedure sort_node(node: node_ptr);
  119. var
  120.    i:        subnode_index;
  121.    swapped:  boolean;
  122.    temp:     node_ptr;
  123.  
  124. begin
  125.    with node^ do
  126.       repeat
  127.          swapped := false;
  128.  
  129.          for i := 1 to count-1 do
  130.             if subs^[i]^.name > subs^[i+1]^.name then
  131.             begin
  132.                temp := subs^[i];
  133.                subs^[i] := subs^[i+1];
  134.                subs^[i+1] := temp;
  135.                swapped := true;
  136.             end;
  137.  
  138.       until swapped = false;
  139. end;
  140.  
  141.  
  142.  
  143. function blanks (len: integer): long_string;
  144. var
  145.    str: long_string;
  146.  
  147. begin
  148.    str := '';
  149.  
  150.    while length (str) < len do
  151.       str := str + ' ';
  152.  
  153.    blanks := str;
  154. end;
  155.  
  156.  
  157.  
  158. function connector (code: connector_codes): long_string;
  159. begin
  160.    connector := connector_strings [ascii_tree, code];
  161. end;
  162.  
  163.  
  164.  
  165. procedure put_node (var fd:     text;              {output file}
  166.                     node:       node_ptr;          {node to output}
  167.                     beforetab:  long_string;       {tabs if before title}
  168.                     titletab:   long_string;       {tabs for title}
  169.                     aftertab:   long_string;       {tabs if after title}
  170.                     before:     connector_codes;   {next tab before title}
  171.                     title:      connector_codes;   {next tab for title}
  172.                     after:      connector_codes);  {next tab after title}
  173.  
  174. var
  175.    i:             subnode_index;
  176.    titlesub:      subnode_index;
  177.  
  178. begin
  179.    with node^ do
  180.    begin
  181.       beforetab := beforetab + connector (before) + blanks (length (name));
  182.       titletab  := titletab  + connector (title ) + name;
  183.       aftertab  := aftertab  + connector (after ) + blanks (length (name));
  184.  
  185.       case count of
  186.          0:     {terminal node with title only}
  187.             writeln (fd, titletab);
  188.  
  189.          1:     {node with 1 subnode}
  190.             put_node (fd, subs^[1], beforetab, titletab, aftertab,
  191.                                     spaces, horizontal, spaces);
  192.  
  193.          2:     {node with 2 subnodes}
  194.             begin
  195.                put_node (fd, subs^[1], beforetab, titletab, aftertab,
  196.                                        spaces, tee, vertical);
  197.  
  198.                put_node (fd, subs^[2], aftertab, aftertab, aftertab,
  199.                                        vertical, bottom, spaces);
  200.             end;
  201.  
  202.          else   {node with n subnodes}
  203.             begin
  204.                titlesub := (count+1) div 2;
  205.  
  206.                writeln (fd, beforetab);
  207.  
  208.                put_node (fd, subs^[1], beforetab, beforetab, beforetab,
  209.                                        spaces, top, vertical);
  210.  
  211.                for i := 2 to titlesub-1 do
  212.                   put_node (fd, subs^[i], beforetab, beforetab, beforetab,
  213.                                           vertical, middle, vertical);
  214.  
  215.                put_node (fd, subs^[titlesub], beforetab, titletab, aftertab,
  216.                                               vertical, cross, vertical);
  217.  
  218.                for i := titlesub+1 to count-1 do
  219.                   put_node (fd, subs^[i], aftertab, aftertab, aftertab,
  220.                                           vertical, middle, vertical);
  221.  
  222.                put_node (fd, subs^[count], aftertab, aftertab, aftertab,
  223.                                            vertical, bottom, spaces);
  224.             end;
  225.       end;
  226.  
  227.    end;
  228.  
  229. end;
  230.  
  231.  
  232.  
  233. (*
  234.  * put_tree - format a tree for output and write it to a file
  235.  *
  236.  *)
  237.  
  238. procedure put_tree (var fd:  text;
  239.                     root:    node_ptr);
  240. begin
  241.    put_node (fd, root, '', '', '', empty, empty, empty);
  242.    flush (fd);
  243. end;
  244.  
  245.  
  246.